Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/sftgrd/2_groups.frm

Visual Basic Form | 1996-06-12 | 7.1 KB | 244 lines

VERSION 2.00
Begin Form fmtTwoGroups
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Two Groups"
   ClientHeight    =   5820
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   7365
   Height          =   6225
   Left            =   1035
   LinkTopic       =   "Form7"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5820
   ScaleWidth      =   7365
   Top             =   1140
   Width           =   7485
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Default         =   -1  'True
      Height          =   495
      Left            =   3120
      TabIndex        =   7
      Top             =   4800
      Width           =   1215
   End
   Begin CommandButton cmdOK
      Caption         =   "OK"
      Height          =   495
      Left            =   3120
      TabIndex        =   6
      Top             =   4080
      Width           =   1215
   End
   Begin CommandButton cmdRemoveAll
      Caption         =   "Remove All"
      Height          =   495
      Left            =   3120
      TabIndex        =   4
      Top             =   2760
      Width           =   1215
   End
   Begin CommandButton cmdRemove
      Caption         =   "<== Remove"
      Height          =   495
      Left            =   3120
      TabIndex        =   3
      Top             =   1800
      Width           =   1215
   End
   Begin CommandButton cmdAdd
      Caption         =   "Add  ==>"
      Height          =   495
      Left            =   3120
      TabIndex        =   2
      Top             =   840
      Width           =   1215
   End
   Begin ListBox lstRight
      Height          =   4905
      Left            =   4800
      MultiSelect     =   2  'Extended
      TabIndex        =   1
      Top             =   600
      Width           =   2295
   End
   Begin ListBox lstLeft
      Height          =   4905
      Left            =   360
      MultiSelect     =   2  'Extended
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   600
      Width           =   2295
   End
   Begin Label lblRight
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblRight"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   -1  'True
      Height          =   375
      Left            =   4800
      TabIndex        =   9
      Top             =   240
      Width           =   2295
   End
   Begin Label lblLeft
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblLeft"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   -1  'True
      Height          =   375
      Left            =   360
      TabIndex        =   8
      Top             =   240
      Width           =   2295
   End
   Begin Label lblExitStatus
      Caption         =   "ExitStatus"
      Height          =   495
      Left            =   3120
      TabIndex        =   5
      Top             =   5280
      Visible         =   0   'False
      Width           =   1215
   End
': 2_GROUPS.FRM
'-    Manage what is in two groups
' Copyright 1994, AA-Software International
'     Distributed for non-commercial educational use only.
'     For other use contact:
'        AA-Software International
'        12 ter Domaine Du Bois Joli
'        06330 Roquefort-Les-Pins, France
'        Tel: [phone]
'        Fax: [phone]
'        Internet: [e-mail]
'        CompuServe: 100343,2570
Option Explicit
Sub cmdAdd_Click ()
   pAddToRight
End Sub
Sub cmdCancel_Click ()
   lblExitStatus.Caption = "CANCEL"
   Me.Hide
End Sub
Sub cmdOK_Click ()
   lblExitStatus.Caption = "OK"
   Me.Hide
End Sub
Sub cmdRemove_Click ()
   pAddToLeft
End Sub
Sub cmdRemoveAll_Click ()
   Dim itemKtr_i As Integer
   'Move all items from Right group to Left group
   For itemKtr_i = 0 To lstRight.ListCount - 1
      lstLeft.AddItem lstRight.List(itemKtr_i)
   Next itemKtr_i
   'Remove All Groups from In-favor list
   lstRight.Clear
   pSetRemoveAllButton
   pSetFocus lstRight, lstLeft
End Sub
Sub Form_Activate ()
   pSetRemoveAllButton
   pSetFocus lstLeft, lstRight
End Sub
Sub Form_Load ()
   cmdAdd.Enabled = False
   cmdRemove.Enabled = False
End Sub
Sub lstLeft_Click ()
   cmdAdd.Enabled = True
   cmdRemove.Enabled = False
End Sub
Sub lstLeft_DblClick ()
   pAddToRight
End Sub
Sub lstRight_Click ()
   cmdAdd.Enabled = False
   cmdRemove.Enabled = True
End Sub
Sub lstRight_DblClick ()
   pAddToLeft
End Sub
Private Sub pAddToLeft ()
   pMoveItem lstRight, lstLeft
End Sub
Private Sub pAddToRight ()
   pMoveItem lstLeft, lstRight
End Sub
Private Sub pMoveItem (lstFrom As Control, lstTo As Control)
   Dim insertPoint_i As Integer
   insertPoint_i = lstTo.ListIndex + 1
   If insertPoint_i > lstTo.ListCount Then insertPoint_i = lstTo.ListCount
   Dim itemKtr_i As Integer
   'Copy from lstFrom to lstTo
   For itemKtr_i = 0 To lstFrom.ListCount - 1
      If lstFrom.Selected(itemKtr_i) Then
         lstTo.AddItem lstFrom.List(itemKtr_i), insertPoint_i
         insertPoint_i = insertPoint_i + 1
      End If
   Next itemKtr_i
   'Remove from lstFrom
   itemKtr_i = 0
   Do While itemKtr_i < lstFrom.ListCount
      If lstFrom.Selected(itemKtr_i) Then
         lstFrom.RemoveItem (itemKtr_i)
      Else
         itemKtr_i = itemKtr_i + 1
      End If

   Loop
   lstTo.Selected(lstTo.ListIndex) = False
   lstTo.ListIndex = insertPoint_i - 1
   lstTo.Selected(lstTo.ListIndex) = True
   pSetRemoveAllButton
   pSetFocus lstFrom, lstTo
End Sub
Private Sub pSetFocus (c1 As Control, c2 As Control)
   If c1.ListCount = 0 Then
      'clear select flag
      Dim listKtr_i As Integer
      For listKtr_i = 0 To c2.ListCount - 1
         c2.Selected(listKtr_i) = False
      Next listKtr_i
      'Select first item
      c2.ListIndex = 0
      c2.Selected(c2.ListIndex) = True
      c2.SetFocus
      Exit Sub
   End If
   If c1.ListIndex >= 0 Then
      'Select the current items
      c1.Selected(c1.ListIndex) = True
   Else
      'Must have fallen off the end of the list Select the last items
      c1.ListIndex = c1.ListCount - 1
      c1.Selected(c1.ListIndex) = True
   End If
   c1.SetFocus
End Sub
Private Sub pSetRemoveAllButton ()
   If lstRight.ListCount > 1 Then
      cmdRemoveAll.Enabled = True
   Else
      cmdRemoveAll.Enabled = False
   End If
End Sub